(** Common histogram hierarchy for the Monitor *)
open Histo
open Glob.Bin
open Glob.Inc

(** this type contains 4 variants of histogram containers:
    1) Hist_list (name,list) -- list of histograms <list> with name <name>
    2) Group g -- where <g> is object of class type group, contained list of
    histograms, intended for automatic filling of histograms through function
    "fill_all"
    3) Matrix_picture (n_rows,n_columns,name, array) -- contains 2d-array of
    histograms <array>, which should have dimensions <n_rows> x <n_columns>
    4) Directory (name,list) -- directory <name> contains list <list> of other
    values ("files") in this directory

    So all this type is ierarhical structure of histogram containers.
    It's intended for direct mapping to GUI structures 
    (e.g. Gtk notebooks and buttons). 
*)

module type Histogram_supplement =
sig
    type t 
    val hist: t -> hist
end 
;;
(*
exception Error of string * hist list
let fail reason =
    raise (Error ("fail: "^reason, []))
*)

module Make (F: Histogram_supplement) = 
struct
(*  class type group=object
      method name: string
      method get_hists: F.t list
      method fill_hists: unit
  end*)
  exception Error of string * F.t list
  let fail reason =
      raise (Error ("fail: "^reason, []))
(*  type group = <
        name: string;
        get_hists: histo_container list;
        fill_hists: unit; >*)
(*  class type group = object 
          method name: string
          method get_hists: histo_container list
          method fill_hists: unit
  end*)
(*  and *)
  type histo_container = [
        `Empty
(*      | `Group of group*)
      | `Elt of F.t
      | `Hist_list of string * F.t list
      | `Matrix_picture of int * int * string * F.t array array
      | `Opt_matrix_picture of int * int * string * (F.t option) array array
      | `Array_picture of int * string * F.t array
  ]

  let clear_container: histo_container -> unit = 
    let clear = Histo.clear $ F.hist in
    function 
      | `Elt h -> clear h
      | `Hist_list (_,hl) -> List.iter clear hl
      | `Array_picture (_,_,a) -> Array.iter clear a
      | `Matrix_picture (_,_,_,m) -> Matrix.iter clear m
      | `Opt_matrix_picture (_,_,_,m) -> Matrix.iter (maybe clear) m
      | `Empty -> ()
  ;;

(*  let group_of g = `Group (g :> group)*)

  let get_from iter str =
      let result = ref [] in
      iter (fun hf ->
(*          let h = F.hist hf in*)
          if str = name (F.hist hf) then result := hf :: !result);
      let n = List.length !result in
      if n = 1
      then (List.hd !result)
      else if n = 0
      then raise (Error ("no one histogram found",[]))
      else raise (Error 
        ("multiple histograms found", !result))
  ;;

(*  let hist = F.hist*)
  let container_name = ( function
          | `Empty -> "-"
(*          | `Group g -> g#name*)
          | `Elt hf -> name (F.hist hf)
          | `Hist_list (name,_) -> name
          | `Matrix_picture (_,_,name,_) -> name
          | `Opt_matrix_picture (_,_,name,_) -> name
          | `Array_picture (_,name,_) -> name
      )

  let rec get_content str (file: histo_container) : F.t = 
    ( match file with
      | `Hist_list (_,l) -> 
           get_from (fun f -> List.iter f l) str
      | `Elt hf -> get_from (fun f -> f hf) str
      | `Empty -> fail "histo_dir: file: empty"
(*      | `Group g -> (
          let path' = Str.global_replace (Str.regexp "\$+") "\$" str in
          try (
            let [elt_name; h_name] = Str.split (Str.regexp "\$") path' in
            let elt = List.find (fun elt -> 
                   elt_name = container_name elt) g#get_hists in
            get_content h_name elt
          ) with Not_found -> raise 
                (Error ("get_content group: incorrect format",[]))
      )
*)
(*                      get_from (fun f -> List.iter f g#get_hists) str*)
      | `Matrix_picture (_,_,_,m) ->
           get_from (fun f -> Matrix.iter f m) str
      | `Opt_matrix_picture (_,_,_,m) ->
           get_from (fun f -> Matrix.iter (maybe f) m) str
      | `Array_picture (_,_,a) ->
           print_endline ("getting "^str);
           print_endline ("array length: "^(string_of_int (Array.length a)));
           Array.iter (print_endline $ name $ F.hist) a;
           get_from (fun f -> Array.iter f a) str
    )
  include Directory.Find_print_make(struct
      type t = histo_container
      let name_of = container_name
  end)
  ;;
(*
  let find cmd dir =
      let name, path = Scanf.sscanf cmd "%s{%s}" ( @* ) in
      let file = find_file ~path dir in
      get_content name file
  ;;
*)
(*  
  let rec fill_all hdir =
      match hdir with
      `Group g -> g#fill_hists 
    | `Directory(name,l) -> List.iter (fun d -> fill_all d ) l
    | _ -> () (** Matrix_picture should be filled via hist group *)
*)  
  let matrix_of arr name =
      let i = Array.length arr
      and j = Array.length arr.(0) in
      (`Matrix_picture (i,j,name,arr))
  
  let array_of arr name =
      let i = Array.length arr in
      (`Array_picture (i,name,arr))
      
end

module Just_histogram =
    struct
        type t = Histo.hist
        let hist h : t = h
    end

module Func_histogram (C: sig type func end) =
      struct
(*          type func = C.func*)
          type t = Histo.hist * C.func
          let hist (h,_) = h
          let f (_,f) = f
      end
